home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / source / demo / text / qsort.pp < prev   
Encoding:
Text File  |  2000-01-01  |  1.7 KB  |  88 lines
  1. {
  2.     $Id: qsort.pp,v 1.1 2000/03/09 02:49:09 alex Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1993-98 by the Free Pascal Development Team
  5.  
  6.     QuickSort Example
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16. program quicksort;
  17.  
  18.   const
  19.      max = 100000;
  20.  
  21.   type
  22.      tlist = array[1..max] of longint;
  23.  
  24.   var
  25.      data : tlist;
  26.  
  27.  
  28. procedure qsort(var a : tlist);
  29.  
  30.     procedure sort(l,r: longint);
  31.       var
  32.          i,j,x,y: longint;
  33.       begin
  34.          i:=l;
  35.          j:=r;
  36.          x:=a[(l+r) div 2];
  37.          repeat
  38.            while a[i]<x do
  39.             inc(i);
  40.            while x<a[j] do
  41.             dec(j);
  42.            if not(i>j) then
  43.              begin
  44.                 y:=a[i];
  45.                 a[i]:=a[j];
  46.                 a[j]:=y;
  47.                 inc(i);
  48.                 j:=j-1;
  49.              end;
  50.          until i>j;
  51.          if l<j then
  52.            sort(l,j);
  53.          if i<r then
  54.            sort(i,r);
  55.       end;
  56.  
  57.     begin
  58.        sort(1,max);
  59.     end;
  60.  
  61. var
  62.   i : longint;
  63. begin
  64.   write('Creating ',Max,' random numbers between 1 and 500000');
  65.   randomize;
  66.   for i:=1 to max do
  67.     data[i]:=random(500000);
  68.   writeln;
  69.   writeln('Sorting...');
  70.   qsort(data);
  71.   writeln;
  72.   for i:=1 to max do
  73.    begin
  74.      write(data[i]:7);
  75.      if (i mod 10)=0 then
  76.       writeln;
  77.    end;
  78. end.
  79. {
  80.   $Log: qsort.pp,v $
  81.   Revision 1.1  2000/03/09 02:49:09  alex
  82.   moved files
  83.  
  84.   Revision 1.2  1998/09/11 10:55:26  peter
  85.     + header+log
  86.  
  87. }
  88.